home *** CD-ROM | disk | FTP | other *** search
/ Gurewich OLE Controls for Visual Basic 4 / Gurewich OLE Controls for Visual Basic 4.iso / ocxprog / programs / ch16 / 3dfloor.frm (.txt) next >
Encoding:
Visual Basic Form  |  1995-08-24  |  6.8 KB  |  226 lines
  1. VERSION 4.00
  2. Begin VB.Form frm3DFloor 
  3.    Caption         =   "The 3D Floor Program"
  4.    ClientHeight    =   4230
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1815
  7.    ClientWidth     =   6720
  8.    Height          =   4920
  9.    Icon            =   "3DFLOOR.frx":0000
  10.    Left            =   1035
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    ScaleHeight     =   4230
  14.    ScaleWidth      =   6720
  15.    Top             =   1185
  16.    Width           =   6840
  17.    Begin VB.Timer Timer1 
  18.       Interval        =   400
  19.       Left            =   3000
  20.       Top             =   2520
  21.    End
  22.    Begin FloorLibCtl.Floor Floor1 
  23.       Left            =   3000
  24.       Top             =   1800
  25.       _version        =   65536
  26.       _extentx        =   741
  27.       _extenty        =   741
  28.       _stockprops     =   0
  29.    End
  30.    Begin VB.Menu mnuFile 
  31.       Caption         =   "&File"
  32.       Begin VB.Menu mnuExit 
  33.          Caption         =   "E&xit"
  34.       End
  35.    End
  36.    Begin VB.Menu mnuHelp 
  37.       Caption         =   "&Help"
  38.       Begin VB.Menu mnuAbout 
  39.          Caption         =   "&About..."
  40.       End
  41.    End
  42. Attribute VB_Name = "frm3DFloor"
  43. Attribute VB_Creatable = False
  44. Attribute VB_Exposed = False
  45. ' All variables must be declared.
  46. Option Explicit
  47. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  48. Select Case KeyCode
  49.        
  50.    Case 37, 100
  51.         'Left key (37) or 4 key (100) was pressed.
  52.         Floor1.Angle = Floor1.Angle + 6
  53.        
  54.    Case 39, 102
  55.         'Right key (39) or 6 key (102) was pressed.
  56.         Floor1.Angle = Floor1.Angle - 6
  57.      
  58.    Case 38, 104
  59.         'Up key (38) or 8 key (104) was pressed.
  60.         Floor1.Advance 40
  61.       
  62.    Case 40, 98
  63.         'Down key (40) or 2 key (98) was pressed.
  64.         Floor1.Advance -40
  65. End Select
  66. ' Display the 3D view.
  67. Floor1.Display3D
  68. End Sub
  69. Private Sub Form_Load()
  70. Dim OpenResult As Integer
  71. Dim Message As String
  72. Dim Path As String
  73. ' Get the name of the directory where the
  74. ' program resides.
  75. Path = App.Path
  76. If Right(Path, 1) <> "\" Then
  77.    Path = Path + "\"
  78. End If
  79. ' Open the FLOOR50.FLR file.
  80. Floor1.filename = Path + "FLOOR50.FLR"
  81. Floor1.hWndDisplay = Me.hWnd
  82. Floor1.NumOfRows = 50
  83. Floor1.NumOfCols = 50
  84. OpenResult = Floor1.Open
  85. ' If FLR file could not be opened, terminate
  86. ' the program.
  87. If OpenResult <> 0 Then
  88.     Message = "Unable to open file: " + Floor1.filename
  89.     Message = Message + Chr(13) + Chr(10)
  90.     Message = Message + "Error Code: " + Str(OpenResult)
  91.     MsgBox Message, vbCritical, "Error"
  92.     End
  93. End If
  94. ' Set the initial user's position and viewing angle.
  95. Floor1.X = 4 * Floor1.CellWidth
  96. Floor1.Y = 4 * Floor1.CellWidth
  97. Floor1.Angle = 0
  98. ' Set the colors of the walls, ceiling, and floor.
  99. Floor1.WallColorA = 7    ' White
  100. Floor1.WallColorB = 4    ' Red
  101. Floor1.CeilingColor = 11 ' Light Cyan
  102. Floor1.FloorColor = 2    ' Green
  103. Floor1.StripeColor = 0   ' Black
  104. ' Load the sprites.
  105. Floor1.SpritePath = Path
  106. Floor1.Sprite(65) = "TREE.BMP"   ' 65 = ASCII of "A"
  107. Floor1.Sprite(66) = "LIGHT.BMP"  ' 66 = ASCII of "B"
  108. Floor1.Sprite(67) = "EX1.BMP"    ' 67 = ASCII of "C"
  109. Floor1.Sprite(68) = "EX2.BMP"    ' 68 = ASCII OF "D"
  110. Floor1.Sprite(69) = "JOG1.BMP"   ' 69 = ASCII OF "E"
  111. Floor1.Sprite(70) = "JOG2.BMP"   ' 70 = ASCII OF "F"
  112. Floor1.Sprite(71) = "JOG3.BMP"   ' 71 = ASCII OF "G"
  113. Floor1.Sprite(72) = "JOG4.BMP"   ' 72 = ASCII OF "H"
  114. ' Set sprite number 66 (the Light sprite)
  115. ' as a soft sprite.
  116. ' (i.e. the user can walk through this sprite).
  117. Floor1.SetSpriteSoft (66)
  118. End Sub
  119. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  120. Static PrevX, PrevY
  121. ' If none of the mouse buttons is pressed down,
  122. ' terminate this procedure.
  123. If Button = 0 Then Exit Sub
  124. ' Change the user's position according to the
  125. ' mouse movement.
  126. If Y < PrevY Then Floor1.Advance 50
  127. If Y > PrevY Then Floor1.Advance -50
  128. If X < PrevX Then Floor1.Angle = Floor1.Angle + 3
  129. If X > PrevX Then Floor1.Angle = Floor1.Angle - 3
  130. ' Display the 3D view.
  131. Floor1.Display3D
  132. ' Update PrevX and PrevY for next time.
  133. PrevX = X
  134. PrevY = Y
  135. End Sub
  136. Private Sub Form_Paint()
  137. ' If the form is minimized, terminate this procedure.
  138. If Me.WindowState = 1 Then Exit Sub
  139. ' Display the 3D view.
  140. Floor1.Display3D
  141. End Sub
  142. Private Sub mnuAbout_Click()
  143. Dim Title
  144. Dim Msg
  145. Dim CR
  146. CR = Chr(13) + Chr(10)
  147. ' The title of the About message box.
  148. Title = "About the 3D Floor Program"
  149. ' Prepare the message of the About message box.
  150. Msg = "This program was written with Visual "
  151. Msg = Msg + "Basic for Windows, using the "
  152. Msg = Msg + "TegoSoft 3D Floor OCX control. "
  153. Msg = Msg + CR + CR
  154. Msg = Msg + "The TegoSoft 3D Floor OCX control "
  155. Msg = Msg + "is part of the TegoSoft OCX Control "
  156. Msg = Msg + "Kit - a collection of various OCX controls. "
  157. Msg = Msg + CR + CR
  158. Msg = Msg + "For more information about the "
  159. Msg = Msg + "TegoSoft OCX Control Kit, contact TegoSoft "
  160. Msg = Msg + "at:"
  161. Msg = Msg + CR + CR
  162. Msg = Msg + "TegoSoft Inc." + CR
  163. Msg = Msg + "P.O. Box 389" + CR
  164. Msg = Msg + "Bellmore, NY 11710"
  165. Msg = Msg + CR + CR
  166. Msg = Msg + "Phone: (516)783-4824"
  167. ' Display the About message box.
  168. MsgBox Msg, vbInformation, Title
  169. End Sub
  170. Private Sub mnuExit_Click()
  171. ' Terminate the program.
  172. Unload Me
  173. End Sub
  174. Private Sub Timer1_Timer()
  175. Static ExerciseFrame As Integer
  176. Static JoggerY As Integer
  177. Static JoggerFrame As Boolean
  178. ' If the form is minimized, terminate this procedure.
  179. If Me.WindowState = 1 Then Exit Sub
  180. ' Display the next frame of the exercising woman
  181. ' (inside the cell at coordinate x=10, y=40).
  182. ' Frame 0 of the exercising woman is sprite
  183. ' number 67. And frame 1 of the exercising woman is
  184. ' sprite number 68.
  185. If ExerciseFrame = 0 Then
  186.    ExerciseFrame = 1
  187.    Floor1.SetCell 10, 40, 67
  188.    ExerciseFrame = 0
  189.    Floor1.SetCell 10, 40, 68
  190. End If
  191. ' Set the cell of the previous jogger position
  192. ' to an empty cell.
  193. If JoggerY <> 0 Then
  194.    Floor1.SetCell 23, JoggerY, 0
  195. End If
  196. ' If the jogger has reached the end of the hall,
  197. ' reset JoggerY to 0.
  198. If JoggerY = 48 Then
  199.    JoggerY = 0
  200. End If
  201. ' Increment JoggerY.
  202. JoggerY = JoggerY + 1
  203. ' Set JoggerFrame to the next frame number.
  204. If (JoggerFrame = 0) Then
  205.    JoggerFrame = 1
  206.    JoggerFrame = 0
  207. End If
  208. ' If the user is facing the jogger, show the front
  209. ' of the jogger (sprites 69 and 70). Otherwise, show
  210. ' the back of the jogger (sprites 71 and 72).
  211. If Floor1.CellPosY >= JoggerY Then
  212.    If JoggerFrame = 0 Then
  213.       Floor1.SetCell 23, JoggerY, 69
  214.    Else
  215.       Floor1.SetCell 23, JoggerY, 70
  216.    End If
  217.    If JoggerFrame = 0 Then
  218.       Floor1.SetCell 23, JoggerY, 71
  219.    Else
  220.       Floor1.SetCell 23, JoggerY, 72
  221.    End If
  222. End If
  223. ' Display th 3D view.
  224. Floor1.Display3D
  225. End Sub
  226.